home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.05 May 91 / Math Parser ƒ / ParserProcs / Functions < prev    next >
Encoding:
Text File  |  1990-02-06  |  3.0 KB  |  179 lines  |  [TEXT/PJMM]
  1. unit Functions;
  2.  
  3.  
  4. interface
  5.  
  6.     uses
  7.         ParserGlobals;
  8.  
  9. {following are the functions supported in the parser, besides the usual abs, sqr,sqrt,sin,cos,}
  10. {exp, ln, round,trunc. log (log to base 10) is also supported.}
  11.  
  12.  
  13.     function asin (var b2: extended): extended;
  14.  
  15.     function acos (var b2: extended): extended;
  16.  
  17.     function tan (var b2: extended): extended;
  18.  
  19.     function atan (var b2: extended): extended;
  20.  
  21.     function sinh (var b2: extended): extended;
  22.  
  23.     function cosh (var b2: extended): extended;
  24.  
  25.     function tanh (var b2: extended): extended;
  26.  
  27.     function inv (var b2: extended): extended;
  28.  
  29.     function invsinh (var b2: extended): extended;
  30.  
  31.     function invcosh (var b2: extended): extended;
  32.  
  33.     function invtanh (var b2: extended): extended;
  34.  
  35.  
  36.  
  37. implementation
  38.  
  39.     function asin;
  40.  
  41.         label
  42.             1, 2;
  43.  
  44.         var
  45.             y1, y2, sq, cub: extended;
  46.             n: integer;
  47.  
  48.     begin
  49.         if (b2 = 1) then                        {Using a Newton-Raphson iteration to 'home in' on the asin function. Starting value}
  50.             begin                                     {determined from the first few terms of series expansion of asin.(done for accuracy)}
  51.                 y1 := pi / 2;
  52.                 goto 2;
  53.             end;
  54.         if (b2 = -1) then
  55.             begin
  56.                 y1 := -pi / 2;
  57.                 goto 2;
  58.             end;
  59.         sq := b2 * b2;
  60.         cub := sq * b2;
  61.         y1 := b2 + cub / 6 + (3 * sq * cub) / 40 + (15 * cub * cub * b2) / 336;
  62.         y1 := y1 + (105 * cub * cub * cub) / 3456;
  63.         n := 0;
  64. 1:
  65.         n := n + 1;
  66.         if n > 25 then
  67.             goto 2;
  68.         y2 := y1 + (b2 - sin(y1)) / cos(y1);
  69.         y1 := y2;
  70.         goto 1;
  71. 2:
  72.         asin := y1;
  73.     end;
  74.  
  75.  
  76.     function acos;
  77.  
  78.         label
  79.             1, 2;
  80.  
  81.         var
  82.             y1, y2, sq, cub: extended;
  83.             n: integer;
  84.  
  85.     begin
  86.         if (b2 = 0) then                {Using a Newton-Raphson iteration to 'home in' on acos.}
  87.             begin                             {First estimate determined from first few terms of a}
  88.                 y1 := 0;                       {series expansion of acos. (done for accuracy)}
  89.                 goto 2;
  90.             end;
  91.         sq := b2 * b2;
  92.         cub := sq * b2;
  93.         y1 := b2 + cub / 6 + (3 * sq * cub) / 40 + (15 * cub * cub * b2) / 336;
  94.         y1 := y1 + (105 * cub * cub * cub) / 3456;
  95.         y1 := pi / 2 - y1;
  96.         n := 0;
  97. 1:
  98.         n := n + 1;
  99.         if n > 25 then
  100.             goto 2;
  101.         y2 := y1 - (b2 - cos(y1)) / sin(y1);
  102.         y1 := y2;
  103.         goto 1;
  104. 2:
  105.         acos := y1;
  106.     end;
  107.  
  108.     function tan;
  109.  
  110.         var
  111.             csn, sgn: extended;
  112.             l: integer;
  113.  
  114.     begin
  115.         csn := cos(b2);
  116.         if csn <= 0 then
  117.             sgn := -1;
  118.         if csn > 0 then
  119.             sgn := 1;
  120.         if abs(csn) <= 1.0e-30 then
  121.             csn := 1.0e-30 * sgn;
  122.         tan := sin(b2) / csn;
  123.     end;
  124.  
  125.     function atan;
  126.  
  127.     begin
  128.         atan := arctan(b2);
  129.     end;
  130.  
  131.     function sinh;
  132.  
  133.     begin
  134.         sinh := 0.5 * (exp(b2) - exp(-b2));
  135.     end;
  136.  
  137.     function cosh;
  138.  
  139.     begin
  140.         cosh := 0.5 * (exp(b2) + exp(-b2));
  141.     end;
  142.  
  143.     function tanh;
  144.  
  145.     begin
  146.         tanh := (exp(2 * b2) - 1) / (exp(2 * b2) + 1);
  147.     end;
  148.  
  149.     function inv;
  150.  
  151.     begin
  152.  
  153.         if b2 <> 0 then
  154.             inv := 1 / b2;
  155.     end;
  156.  
  157.     function invsinh;
  158.  
  159.     begin
  160.         invsinh := ln(b2 + sqrt(b2 * b2 + 1));
  161.     end;
  162.  
  163.     function invcosh;
  164.  
  165.     begin
  166.         if (b2 >= 1) then
  167.             invcosh := ln(b2 + sqrt(b2 * b2 - 1));
  168.     end;
  169.  
  170.     function invtanh;
  171.  
  172.     begin
  173.         if (b2 * b2 >= 0) and (b2 * b2 < 1) then
  174.             invtanh := 0.5 * ln((1 + b2) / (1 - b2));
  175.     end;
  176.  
  177.  
  178.  
  179. end.